home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / pleas / ole / visio / network / vissheet.bas < prev   
Encoding:
BASIC Source File  |  1994-05-18  |  27.0 KB  |  804 lines
  1. '------------------------------------------------------------------------------
  2. '------------------------------------------------------------------------------
  3. '--
  4. '--                               Visio OLE Automation
  5. '--                              Shape Sheet "Wrappers"
  6. '--
  7. '--   File Name : vissheet.bas
  8. '--
  9. '-- Description : Contains high level interface to the four changeable shape
  10. '--               sheet sections (Geometry, Scratch, Control Point and
  11. '--               Connection Point).
  12. '--
  13. '------------------------------------------------------------------------------
  14. '------------------------------------------------------------------------------
  15. 'This file contains sample code for using Visual Basic and OLE 2.0 to
  16. 'automatically create a Visio network diagram from a Microsoft Access
  17. 'database.
  18. '
  19. 'IMPORTANT:  NETVB.ZIP is ONLY a sample, not a released product.  It was
  20. 'not extensively tested, and has no guarantee.  In addition, we do not provide
  21. 'documentation or support for this file.
  22.  
  23. Option Explicit
  24.  
  25. '--
  26. '-- Type & Global Declarations
  27. '--
  28.  
  29. Global Const SIDE_TOP = 1
  30. Global Const SIDE_BOTTOM = 2
  31. Global Const SIDE_LEFT = 3
  32. Global Const SIDE_RIGHT = 4
  33.  
  34. Global Const visLineTo = 0
  35. Global Const visArcTo = 1
  36. Global Const visElArctTo = 2
  37.  
  38. Type VisPoint
  39.   X As Variant
  40.   Y As Variant
  41. End Type
  42.  
  43. Type CtrlHandle
  44.   X As Variant
  45.   Y As Variant
  46.   XDynamic As Variant
  47.   YDynamic As Variant
  48.   XBehavior As Variant
  49.   YBehavior As Variant
  50.   CanGlue As Variant
  51. End Type
  52.  
  53. Type ScratchRow
  54.   X As Variant
  55.   Y As Variant
  56.   A As Variant
  57.   B As Variant
  58.   C As Variant
  59.   D As Variant
  60. End Type
  61.  
  62. Type CnctPoint
  63.   X As Variant
  64.   Y As Variant
  65. End Type
  66.  
  67. Type Vertex
  68.   VtxType As Integer
  69.  
  70.   X As Variant
  71.   Y As Variant
  72.  
  73.   Bow As Variant
  74.  
  75.   XControlPoint As Variant
  76.   YControlPoint As Variant
  77.   Ecentricity As Variant
  78.   MajMinRatio As Variant
  79. End Type
  80.  
  81. Function AddCnctPoint (shp As Object, iPos As Integer) As Integer
  82. '-----------------------------------
  83. '--- AddCnctPoint ------------------
  84. '--
  85. '--   Use AddCnctPoint to add a new control point to a Shape object.
  86. '--
  87. '-- Parameters   : shp  - Visio Shape object to add row to.
  88. '--                iPos - 1 based index of new point (row) to be added.  Also
  89. '--                       accepts visRowLLast.
  90. '--
  91. '-- Return Value : 1 based index of point added if no error occurs.  Otherwise
  92. '--                visRowNone.
  93. '--
  94.  
  95.   Dim iRowIndex As Integer, iTemp As Integer
  96.   
  97.   If Not IsShape(shp) Or Not (iPos > 0 Or iPos = visRowLast) Then
  98.     AddCnctPoint = visRowNone
  99.     Exit Function
  100.   End If
  101.  
  102.   If iPos <> visRowLast Then                '-- Index Was Passed...
  103.     iRowIndex = visRowFirst + (iPos - 1)    '--   Convert To Row Index
  104.   Else                                      '-- Otherwise...
  105.     iRowIndex = visRowLast                  '--   Use Last Row
  106.   End If
  107.  
  108. '-- Next we add the row.  If all goes well iTemp should be the 0 based row
  109. '-- index added.  If visRowNone is not returned we add one to it to make the
  110. '-- 1 based index.
  111.  
  112.   iTemp = shp.AddRow(visSectionExport, iRowIndex, 0)
  113.  
  114.   If iTemp <> visRowNone Then iTemp = iTemp + 1
  115.  
  116.   AddCnctPoint = iTemp
  117. End Function
  118.  
  119. Function AddCtrlHandle (shp As Object, iPos As Integer) As Integer
  120. '-----------------------------------
  121. '--- AddCtrlHandle -----------------
  122. '--
  123. '--   Use AddCtrlHandle to add a new control handle to a Shape object.
  124. '--
  125. '-- Parameters   : shp  - Visio Shape object to add handle to.
  126. '--                iPos - 1 based index of handle (row) to be added.  Also
  127. '--                       accepts visRowLLast.
  128. '--
  129. '-- Return Value : 1 based index of handle added if no error occurs.  Otherwise
  130. '--                visRowNone.
  131. '--
  132.  
  133.   Dim iRowIndex As Integer, iTemp As Integer
  134.   
  135.   If Not IsShape(shp) Or Not (iPos > 0 Or iPos = visRowLast) Then
  136.     AddCtrlHandle = visRowNone
  137.     Exit Function
  138.   End If
  139.  
  140.   If iPos <> visRowLast Then                '-- Index Was Passed...
  141.     iRowIndex = visRowFirst + (iPos - 1)    '--   Convert To Row Index
  142.   Else                                      '-- Otherwise...
  143.     iRowIndex = visRowLast                  '--   Use Last Row
  144.   End If
  145.  
  146. '-- Next we add the row.  If all goes well iTemp should be the 0 based row
  147. '-- index added.  If visRowNone is not returned we just add one to the row
  148. '-- index and return it.
  149.  
  150.   iTemp = shp.AddRow(visSectionControls, iRowIndex, 0)
  151.  
  152.   If iTemp <> visRowNone Then iTemp = iTemp + 1
  153.  
  154.   AddCtrlHandle = iTemp
  155. End Function
  156.  
  157. Function AddGmtrySect (shp As Object, iSection As Integer) As Integer
  158. '-----------------------------------
  159. '--- AddGmtrySect ------------------
  160. '--
  161. '--   Adds a geometry section to a shape sheet using 1 based indexes.  If the
  162. '-- section index passed is larger than the section count the new section is
  163. '-- added at the end.
  164. '--
  165. '-- Parameters   : shp      - Visio Shape to add section to.
  166. '--                iSection - 1 based index of section to add.  If the section
  167. '--                           exists a blank one is inserted.  visSecLLast is
  168. '--                           a valid argument.
  169. '--
  170. '-- Return Value : visSecNone if an error occurs, otherwise the 1 based index
  171. '--                of the section added.
  172. '--
  173.  
  174.   Dim iSecIndex As Integer, iTemp As Integer
  175.  
  176.   AddGmtrySect = visSectionNone                 '-- Default To No Section Added
  177.  
  178.   If Not IsShape(shp) Or Not (iSection > 0 Or iSection = visSectionLastComponent) Then
  179.     Exit Function
  180.   End If
  181.  
  182.   If iSection <> visSectionLastComponent Then
  183.     iSecIndex = visSectionFirstComponent + (iSection - 1)
  184.   Else
  185.     iSecIndex = visSectionLastComponent
  186.   End If
  187. '--
  188. '--   Now we add the row.  On return, iTemp either has visSecNone if an error
  189. '-- occurred or the index of the section added.  If visSecNone we just exit
  190. '-- out.  Otherwise we use iTemp to add the property and Move To rows at the
  191. '-- beginning of the section.  Finally we return the 1 based sectio index.
  192. '--
  193.  
  194.   iTemp = shp.AddSection(iSecIndex)
  195.  
  196.   If iTemp <> visSectionNone Then
  197.     shp.AddRow iTemp, visRowFirst, visTagComponent
  198.     shp.AddRow iTemp, visRowFirst + 1, visTagMoveTo
  199.  
  200.     AddGmtrySect = iTemp + 1 - visSectionFirstComponent
  201.   End If
  202. End Function
  203.  
  204. Function AddScratchRow (shp As Object, iPos As Integer) As Integer
  205. '-----------------------------------
  206. '--- AddScratchRow -----------------
  207. '--
  208. '--   Adds a new scratch row to a Shape object.
  209. '--
  210. '-- Parameters   : shp  - Visio Shape object to add row to.
  211. '--                iPos - 1 based index of new row to be added.  Accepts
  212. '--                       visRowLLast.
  213. '--
  214. '-- Return Value : 1 based index of row added if no error occurs.  Otherwise
  215. '--                visRowNone.
  216. '--
  217.  
  218.   Dim iRowIndex As Integer, iTemp As Integer
  219.   
  220.   If Not IsShape(shp) Or Not (iPos > 0 Or iPos = visRowLast) Then
  221.     AddScratchRow = visRowNone
  222.     Exit Function
  223.   End If
  224.  
  225.   If iPos <> visRowLast Then               '-- Index Was Passed...
  226.     iRowIndex = visRowFirst + (iPos - 1)    '--   Convert To Row Index
  227.   Else                                      '-- Otherwise...
  228.     iRowIndex = visRowLast                 '--   Use Last Row
  229.   End If
  230.  
  231. '-- Next we add the row.  If all goes well iTemp should be the 0 based row
  232. '-- index added.  If it doesn't match with iRowIndex then an error occured
  233. '-- and we return the proper error code.
  234.  
  235.   iTemp = shp.AddRow(visSectionScratch, iRowIndex, 0)
  236.  
  237.   If iTemp <> visRowNone Then iTemp = iTemp + 1
  238.  
  239.   AddScratchRow = iTemp
  240. End Function
  241.  
  242. Function BestExportPoint (shp As Object, iSide As Integer) As Integer
  243. '-----------------------------------
  244. '--- BestExportPoint ---------------
  245. '--
  246. '--   Finds the best connection(export) point on a shape for any given side.
  247. '--
  248. '-- Return Value : 1 based index of best export point.
  249. '--
  250.  
  251.     Dim dMax As Double, dResult As Double, cell As Object
  252.     Dim iBest As Integer, iRow As Integer, iCol As Integer
  253.     Dim iRows As Integer
  254.  
  255.     If Not IsShape(shp) Then Exit Function
  256.  
  257.     iBest = 1
  258.     dMax = 0
  259.     iRows = shp.RowCount(visSectionExport)
  260.  
  261.     Select Case iSide
  262.         Case SIDE_LEFT, SIDE_RIGHT: iCol = 0
  263.         Case SIDE_TOP, SIDE_BOTTOM: iCol = 1
  264.     End Select
  265.  
  266.     For iRow = 0 To iRows
  267.         Set cell = shp.CellsSRC(visSectionExport, iRow, iCol)
  268.         dResult = cell.ResultIU
  269.         
  270.         Select Case iSide
  271.             Case SIDE_LEFT, SIDE_BOTTOM
  272.                 If dResult < dMax Then
  273.                     dMax = dResult
  274.                     iBest = iRow
  275.                 End If
  276.             Case SIDE_RIGHT, SIDE_TOP
  277.                 If dResult > dMax Then
  278.                     dMax = dResult
  279.                     iBest = iRow
  280.                 End If
  281.         End Select
  282.     Next iRow
  283.  
  284.     BestExportPoint = (iBest + 1)
  285. End Function
  286.  
  287. Sub DelConnectSection (shp As Object)
  288. '-----------------------------------
  289. '--- DelConnectSection -------------
  290. '--
  291. '--   Removes the Connection section from a shape sheet.  Use carefully!
  292. '--
  293. '-- Paremeters : shp - Shape sheet to remove connection section from.
  294. '--
  295.  
  296.   If IsShape(shp) Then shp.DeleteSection visSectionExport
  297. End Sub
  298.  
  299. Sub DeleteCnctPoint (shp As Object, iPos As Integer)
  300. '-----------------------------------
  301. '--- DeleteCnctPoint ---------------
  302. '--
  303. '--   Use DeleteCnctPoint to remove a connection point from a Shape object.
  304. '-- Offers 1 based row indexes and a safe method for deleting points.  Will not
  305. '-- remove the connection section if deleting the last row.  If the row index
  306. '-- passed does not exist then nothing is deleted.
  307. '--
  308. '-- Parameters   : shp  - Shape to delete point from.
  309. '--                iPos - 1 based index of point to be deleted.  Do NOT use
  310. '--                       row constants.
  311. '--
  312.  
  313.   If Not IsShape(shp) Or (iPos <= 0) Then Exit Sub
  314.  
  315.   shp.DeleteRow visSectionExport, visRowFirst + (iPos - 1)
  316. End Sub
  317.  
  318. Sub DeleteCtrlHandle (shp As Object, iPos As Integer)
  319. '-----------------------------------
  320. '--- DeleteCtrlHandle --------------
  321. '--
  322. '--   Use DeleteCtrlHandle to remove a control handle from a Shape object.
  323. '-- Offers 1 based row indexes and a safe method for deleting handles.  Will not
  324. '-- remove the controls section if deleting the last row.  If the row index
  325. '-- passed does not exist then nothing is deleted.
  326. '--
  327. '-- Parameters   : shp  - Shape to delete handle from.
  328. '--                iPos - 1 based index of handle to be deleted.  Do NOT use
  329. '--                       row constants.
  330. '--
  331.  
  332.   If Not IsShape(shp) Or (iPos <= 0) Then Exit Sub
  333.  
  334.   shp.DeleteRow visSectionControls, visRowFirst + (iPos - 1)
  335. End Sub
  336.  
  337. Sub DeleteScratchRow (shp As Object, iPos As Integer)
  338. '-----------------------------------
  339. '--- DeleteScratchRow --------------
  340. '--
  341. '--   Use DeleteScratchRow to remove a scratch row from a Shape object.
  342. '-- Offers 1 based row indexes and a safe method of deleting rows.  Will not
  343. '-- remove the scratch section if deleting the last row.  If the row index
  344. '-- passed does not exist then nothing is deleted.
  345. '--
  346. '-- Parameters   : shp  - Shape to delete row from.
  347. '--                iPos - 1 based index of row to be deleted.  Do NOT use
  348. '--                       row constants.
  349. '--
  350. '-- Return Value : None
  351. '--
  352.  
  353.   If Not IsShape(shp) Or (iPos <= 0) Then Exit Sub
  354.  
  355.   shp.DeleteRow visSectionScratch, visRowFirst + (iPos - 1)
  356. End Sub
  357.  
  358. Sub DelGmtrySect (shp As Object, iSection As Integer)
  359. '-----------------------------------
  360. '--- DelGmtrySect ------------------
  361. '--
  362. '--   Deletes a geometry section from a shape sheet.
  363. '--
  364. '-- Parameters : shp      - Shape object from which to delete the section.
  365. '--              iSection - 1 based index of section to delete.  If the section
  366. '--                         does not exists nothing is deleted.  visSecLLast
  367. '--                         is a valid argument.
  368. '--
  369.  
  370.   Dim iSecIndex As Integer
  371.  
  372.   If Not IsShape(shp) Or Not (iSection > 0 Or iSection = visSectionLastComponent) Then
  373.     Exit Sub
  374.   End If
  375.  
  376.   If iSecIndex <> visSectionLastComponent Then
  377.     iSecIndex = visSectionFirstComponent + (iSection - 1)
  378.   Else
  379.     iSecIndex = visSectionLastComponent
  380.   End If
  381.  
  382.   shp.DeleteSection iSecIndex
  383. End Sub
  384.  
  385. Sub DelHandleSection (shp As Object)
  386. '-----------------------------------
  387. '--- DelHandleSection --------------
  388. '--
  389. '--   Removes the Control handles section from a shape sheet.  Use carefully!
  390. '--
  391. '-- Paremeters : shp - Shape sheet to remove control handle section from.
  392. '--
  393.  
  394.   If IsShape(shp) Then shp.DeleteSection visSectionControls
  395. End Sub
  396.  
  397. Sub DelScratchSection (shp As Object)
  398. '-----------------------------------
  399. '--- DelScratchSection -------------
  400. '--
  401. '--   Removes the Scratch section from a shape sheet.  Use carefully!
  402. '--
  403. '-- Paremeters : shp - Shape sheet to remove Scratch section from.
  404. '--
  405.  
  406.   If IsShape(shp) Then shp.DeleteSection visSectionScratch
  407. End Sub
  408.  
  409. Function GetClosedFlag (shp As Object, iSection As Integer) As Variant
  410. '-----------------------------------
  411. '--- GetClosedFlag -----------------
  412. '--
  413. '--   Returns the Closed flag formula for a geometry section.
  414. '--
  415. '-- Parameters   : shp      - Shape sheet to act upon.
  416. '--                iSection - 1 based index of section to get Closed flag from.
  417. '--
  418. '-- Return Value : Variant containing the Closed flag formula.  Null if the
  419. '--                section doesn't exist.
  420. '--
  421.  
  422.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then
  423.     GetClosedFlag = Null
  424.     Exit Function
  425.   End If
  426.   
  427.   GetClosedFlag = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 0).Formula
  428. End Function
  429.  
  430. Sub GetCnctPoint (shp As Object, iPos As Integer, Pnt As CnctPoint)
  431. '-----------------------------------
  432. '--- GetCnctPoint ------------------
  433. '--
  434. '--   Retrieves a connection point structure from a shape.
  435. '--
  436. '-- Parameters   : shp  - Shape sheet to get point from.
  437. '--                iPos - 1 based index of point to retrieve.  Do NOT use
  438. '--                       row constants.
  439. '--                Pnt  - Structure to receive connect point's contents.
  440. '--
  441.  
  442.   Dim iRowIndex As Integer
  443.  
  444.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCnctPts!
  445.   If Not (iPos >= 1 And iPos <= TotalCnctPts(shp)) Then Exit Sub
  446.  
  447.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  448.  
  449.   Pnt.X = shp.CellsSRC(visSectionExport, iRowIndex, 0).Formula
  450.   Pnt.Y = shp.CellsSRC(visSectionExport, iRowIndex, 1).Formula
  451. End Sub
  452.  
  453. Sub GetCtrlHandle (shp As Object, iPos As Integer, Pnt As CtrlHandle)
  454. '-----------------------------------
  455. '--- GetCtrlHandle -----------------
  456. '--
  457. '--   Retrieves a control handle structure from a shape.
  458. '--
  459. '-- Parameters   : shp  - Shape sheet to get handle from.
  460. '--                iPos - 1 based index of handle to retrieve.  Do NOT use
  461. '--                       row constants.
  462. '--                Pnt  - Structure to receive control handle's contents.
  463. '--
  464.  
  465.   Dim iRowIndex As Integer
  466.  
  467.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCtrlPts!
  468.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  469.  
  470.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  471.  
  472.   Pnt.X = shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula
  473.   Pnt.Y = shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula
  474.   Pnt.XDynamic = shp.CellsSRC(visSectionControls, iRowIndex, 2).Formula
  475.   Pnt.YDynamic = shp.CellsSRC(visSectionControls, iRowIndex, 3).Formula
  476.   Pnt.XBehavior = shp.CellsSRC(visSectionControls, iRowIndex, 4).Formula
  477.   Pnt.YBehavior = shp.CellsSRC(visSectionControls, iRowIndex, 5).Formula
  478.   Pnt.CanGlue = shp.CellsSRC(visSectionControls, iRowIndex, 6).Formula
  479. End Sub
  480.  
  481. Sub GetCtrlHandlePt (shp As Object, iPos As Integer, Pnt As VisPoint)
  482. '-----------------------------------
  483. '--- GetCtrlHandle -----------------
  484. '--
  485. '--   Retrieves a control handle X,Y point structure from a shape.
  486. '--
  487. '-- Parameters   : shp  - Shape sheet to get handle from.
  488. '--                iPos - 1 based index of handle to retrieve.  Do NOT use
  489. '--                       row constants.
  490. '--                Pnt  - Structure to receive control handle's X,Y point.
  491. '--
  492.  
  493.   Dim iRowIndex As Integer
  494.  
  495.   'If Not IsShape(shp) Then Exit Sub     'Called By TotalCtrlPts!
  496.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  497.  
  498.   iRowIndex = visRowFirst + (iPos - 1)      '--   Convert Index
  499.  
  500.   Pnt.X = shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula
  501.   Pnt.Y = shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula
  502. End Sub
  503.  
  504. Function GetHiddenFlag (shp As Object, iSection As Integer) As Variant
  505. '-----------------------------------
  506. '--- GetHiddenFlag -----------------
  507. '--
  508. '--   Returns the Hidden flag formula for a given geometry section.
  509. '--
  510. '-- Parameters   : shp      - Shape sheet to act upon.
  511. '--                iSection - 1 based index of section to get Hidden flag from.
  512. '--
  513. '-- Return Value : Variant containing the Hidden flag formula.  Null if the
  514. '--                section doesn't exist.
  515. '--
  516.  
  517.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then
  518.     GetHiddenFlag = Null
  519.     Exit Function
  520.   End If
  521.  
  522.   GetHiddenFlag = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 2).Formula
  523. End Function
  524.  
  525. Sub GetScratchRow (shp As Object, iPos As Integer, Row As ScratchRow)
  526. '-----------------------------------
  527. '--- GetScratchRow -----------------
  528. '--
  529. '--   Retrieves a scratch row from a shape sheet.  If the row does not exist
  530. '-- then nothing is retrieved.
  531. '--
  532. '-- Parameters   : shp  - Shape sheet to get row from.
  533. '--                iPos - 1 based index of row to retrieve.  Do NOT use
  534. '--                       row constants.
  535. '--                Row  - Structure to receive the row's content.
  536. '--
  537.  
  538.   Dim iRowIndex As Integer
  539.  
  540.   'If Not IsShape(shp) Then Exit Sub  'Called By TotalScratchRows!
  541.   If Not (iPos >= 1 And iPos <= TotalScratchRows(shp)) Then Exit Sub
  542.  
  543.   iRowIndex = visRowFirst + (iPos - 1)
  544.  
  545.   Row.X = shp.CellsSRC(visSectionScratch, iRowIndex, 0).Formula
  546.   Row.Y = shp.CellsSRC(visSectionScratch, iRowIndex, 1).Formula
  547.   Row.A = shp.CellsSRC(visSectionScratch, iRowIndex, 2).Formula
  548.   Row.B = shp.CellsSRC(visSectionScratch, iRowIndex, 3).Formula
  549.   Row.C = shp.CellsSRC(visSectionScratch, iRowIndex, 4).Formula
  550.   Row.D = shp.CellsSRC(visSectionScratch, iRowIndex, 5).Formula
  551. End Sub
  552.  
  553. Sub GetStartPoint (shp As Object, iSection As Integer, Pnt As VisPoint)
  554. '-----------------------------------
  555. '--- GetStartPoint -----------------
  556. '--
  557. '--   Retrieves the start point row, AKA MoveTo row, from a shape sheet
  558. '-- geometry section.
  559. '--
  560. '-- Parameters : shp      - Shape sheet to act on.
  561. '--              iSection - 1 based index of geometry section.
  562. '--              Pnt      - VisPoint structure to receive point.
  563. '--
  564.  
  565.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  566.  
  567.   Pnt.X = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 0).Formula
  568.   Pnt.Y = shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 1).Formula
  569. End Sub
  570.  
  571. Function GmtryCount (shp As Object) As Integer
  572. '-----------------------------------
  573. '--- GmtryCount --------------------
  574. '--
  575. '--   Returns the number of geometry sections in a shape sheet.
  576. '--
  577. '-- Parameters : shp - Shape to get geometry count from.
  578. '--
  579.  
  580.   If IsShape(shp) Then GmtryCount = shp.GeometryCount
  581. End Function
  582.  
  583. Function HandleCount (shp As Object) As Integer
  584. '-----------------------------------
  585. '--- HandleCount -------------------
  586. '--
  587. '--   Returns the total number of control handles in a shape sheet.  Zero is
  588. '-- returned even if shape is invalid.
  589. '--
  590.  
  591.   If IsShape(shp) Then
  592.     HandleCount = shp.RowCount(visSectionControls)
  593.   End If
  594. End Function
  595.  
  596. Function IsShape (shp As Object) As Integer
  597. '-----------------------------------
  598. '--- IsShape -----------------------
  599. '--
  600. '--   Returns a boolean indicating if shp is a shape object
  601. '--
  602.  
  603.   IsShape = Not (shp Is Nothing) And Not (shp.Dump(0) <> visShape)
  604. End Function
  605.  
  606. Sub SetClosedFlag (shp As Object, iSection As Integer, Flag As Variant)
  607. '-----------------------------------
  608. '--- SetClosedFlag -----------------
  609. '--
  610. '--   Changes the closed flag for a section.  No changes are made if the
  611. '-- section doesn't exist.
  612. '--
  613. '-- Parameters : shp      - Shape sheet on which to act.
  614. '--              iSection - 1 based index of geometry section to use.  Do NOT
  615. '--                         use section constats.
  616. '--               Flag    - New formula for closed flag cell.
  617. '--
  618.  
  619.   'IsShape is called indirectly by GmtryCount
  620.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  621.  
  622.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 0).Formula = Flag
  623. End Sub
  624.  
  625. Sub SetCnctPoint (shp As Object, iPos As Integer, NewPoint As CnctPoint)
  626. '-----------------------------------
  627. '--- SetCnctPoint ------------------
  628. '--
  629. '--   Sets a connection point using a CnctPoint structure.  No changes are made
  630. '-- unless the point exists.
  631. '--
  632. '-- Parameters   : shp      - Shape sheet to get cell from.
  633. '--                iPos     - 1 based index of connection point to replace.
  634. '--                           Do NOT use row constants.
  635. '--                NewPoint - Contains new connection point contents.
  636. '--
  637.  
  638.   Dim iRowIndex As Integer
  639.  
  640.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCnctPts
  641.   If Not (iPos >= 1 And iPos <= TotalCnctPts(shp)) Then Exit Sub
  642.  
  643.   iRowIndex = visRowFirst + (iPos - 1)
  644.  
  645.   shp.CellsSRC(visSectionExport, iRowIndex, 0).Formula = NewPoint.X
  646.   shp.CellsSRC(visSectionExport, iRowIndex, 1).Formula = NewPoint.Y
  647. End Sub
  648.  
  649. Sub SetCtrlHandle (shp As Object, iPos As Integer, NewPoint As CtrlHandle)
  650. '-----------------------------------
  651. '--- SetCtrlHandle -----------------
  652. '--
  653. '--   Sets a control point using a CtrlHandle structure.  No changes are made
  654. '-- unless the point exists.
  655. '--
  656. '-- Parameters   : shp      - Shape sheet to get cell from.
  657. '--                iPos     - 1 based index of control point to replace.  Do not
  658. '--                           use row constants.
  659. '--                NewPoint - Contains new control handle contents.
  660. '--
  661.  
  662.   Dim iRowIndex As Integer
  663.  
  664.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCtrlPts
  665.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  666.  
  667.   iRowIndex = visRowFirst + (iPos - 1)
  668.  
  669.   shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula = NewPoint.X
  670.   shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula = NewPoint.Y
  671.   shp.CellsSRC(visSectionControls, iRowIndex, 2).Formula = NewPoint.XDynamic
  672.   shp.CellsSRC(visSectionControls, iRowIndex, 3).Formula = NewPoint.YDynamic
  673.   shp.CellsSRC(visSectionControls, iRowIndex, 4).Formula = NewPoint.XBehavior
  674.   shp.CellsSRC(visSectionControls, iRowIndex, 5).Formula = NewPoint.YBehavior
  675.   shp.CellsSRC(visSectionControls, iRowIndex, 6).Formula = NewPoint.CanGlue
  676. End Sub
  677.  
  678. Sub SetCtrlHandlePt (shp As Object, iPos As Integer, NewPoint As VisPoint)
  679. '-----------------------------------
  680. '--- SetCtrlHandlePt ---------------
  681. '--
  682. '--   Sets a control handles X,Y point only using a VisPoint structure.  No
  683. '-- changes are made unless the point exists.
  684. '--
  685. '-- Parameters   : shp      - Shape sheet to get cell from.
  686. '--                iPos     - 1 based index of control point to replace.  Do not
  687. '--                           use row constants.
  688. '--                NewPoint - Contains new control handle X,Y point.
  689. '--
  690.  
  691.   Dim iRowIndex As Integer
  692.  
  693.   'If Not IsShape(shp) Then Exit Sub 'Called By TotalCtrlPts
  694.   If Not (iPos >= 1 And iPos <= HandleCount(shp)) Then Exit Sub
  695.  
  696.   iRowIndex = visRowFirst + (iPos - 1)
  697.  
  698.   shp.CellsSRC(visSectionControls, iRowIndex, 0).Formula = NewPoint.X
  699.   shp.CellsSRC(visSectionControls, iRowIndex, 1).Formula = NewPoint.Y
  700. End Sub
  701.  
  702. Sub SetHiddenFlag (shp As Object, iSection As Integer, Flag As Variant)
  703. '-----------------------------------
  704. '--- SetHiddenFlag -----------------
  705. '--
  706. '--   Changes the hidden flag for a section.  No changes are made if the
  707. '-- section doesn't exist.
  708. '--
  709. '-- Parameters : shp      - Shape sheet on which to act.
  710. '--              iSection - 1 based index of geometry section to use.  Do NOT
  711. '--                         use section constats.
  712. '--               Flag    - New formula for hidden flag cell.
  713. '--
  714.  
  715.   'IsShape is called indirectly by GmtryCount
  716.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  717.  
  718.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 0, 2).Formula = Flag
  719. End Sub
  720.  
  721. Sub SetScratchRow (shp As Object, iPos As Integer, NewRow As ScratchRow)
  722. '-----------------------------------
  723. '--- SetScratchRow -----------------
  724. '--
  725. '--   Set the contents of scratch rows using a ScratchRow structure.  No changes
  726. '-- are made if the row doesn't exist.
  727. '--
  728. '-- Parameters   : shp     - Shape sheet to get cell from.
  729. '--                iPos    - 1 based index of row to retrieve.
  730. '--                NewRow  - Contains new contents for the row.
  731.  
  732.   Dim iRowIndex As Integer
  733.  
  734.   'If Not IsShape(shp) Then Exit Sub  'Called By TotalScratchRows
  735.   If Not (iPos >= 1 And iPos <= TotalScratchRows(shp)) Then Exit Sub
  736.  
  737.   iRowIndex = visRowFirst + (iPos - 1)
  738.  
  739.   shp.CellsSRC(visSectionScratch, iRowIndex, 0).Formula = NewRow.X
  740.   shp.CellsSRC(visSectionScratch, iRowIndex, 1).Formula = NewRow.Y
  741.   shp.CellsSRC(visSectionScratch, iRowIndex, 2).Formula = NewRow.A
  742.   shp.CellsSRC(visSectionScratch, iRowIndex, 3).Formula = NewRow.B
  743.   shp.CellsSRC(visSectionScratch, iRowIndex, 4).Formula = NewRow.C
  744.   shp.CellsSRC(visSectionScratch, iRowIndex, 5).Formula = NewRow.D
  745. End Sub
  746.  
  747. Sub SetStartPoint (shp As Object, iSection As Integer, Pnt As VisPoint)
  748. '-----------------------------------
  749. '--- SetStartPoint -----------------
  750. '--
  751. '--   Sets the start point row, AKA MoveTo row, in a shape sheet geometry
  752. '-- section.
  753. '--
  754. '-- Parameters : shp      - Shape sheet to act on.
  755. '--              iSection - 1 based index of geometry section.
  756. '--              Pnt      - VisPoint structure containing new point.
  757. '--
  758.  
  759.   If Not (iSection >= 1 And iSection <= GmtryCount(shp)) Then Exit Sub
  760.  
  761.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 0).Formula = Pnt.X
  762.   shp.CellsSRC(visSectionFirstComponent + (iSection - 1), 1, 1).Formula = Pnt.Y
  763. End Sub
  764.  
  765. Function TotalCnctPts (shp As Object) As Integer
  766. '-----------------------------------
  767. '--- TotalCnctPts ------------------
  768. '--
  769. '--   Returns the total number of connection points in a shape sheet.  Zero is
  770. '-- returned even if the shape is invalid.
  771. '--
  772.  
  773.   If IsShape(shp) Then
  774.     TotalCnctPts = shp.RowCount(visSectionExport)
  775.   End If
  776. End Function
  777.  
  778. Function TotalScratchRows (shp As Object) As Integer
  779. '-----------------------------------
  780. '--- TotalScratchRows --------------
  781. '--
  782. '--   Returns the total number of scratch rows in a shape sheet.  Zero is
  783. '-- returned even if the shape is invalid.
  784. '--
  785.  
  786.   If IsShape(shp) Then
  787.     TotalScratchRows = shp.RowCount(visSectionScratch)
  788.   End If
  789. End Function
  790.  
  791. Function VertexCount (shp As Object, iSection As Integer) As Integer
  792. '-----------------------------------
  793. '--- VertexCount -------------------
  794. '--
  795. '--   Returns the number of verticies in a shape sheet geometry section.  This
  796. '-- count does not include the property row.
  797. '--
  798.  
  799.   If Not IsShape(shp) Then Exit Function
  800.  
  801.   VertexCount = shp.RowCount(visSectionFirstComponent + (iSection - 1)) - 1
  802. End Function
  803.  
  804.